perm filename SAP.SAI[PIC,HE] blob sn#428034 filedate 1979-03-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry  
C00025 ENDMK
CāŠ—;
entry  ;
begin   "sap"

  comment    Programmed by K Ramesh Babu;
  comment  September 29, 1978.

     This module implements the sap file -- sap for super-
    antiparallels.  Since a sap can contain an arbitrary number
    of apars, these component apars are stored in another
    file (sap1). Thus the sap file can contain uniform size records.
    In the description of a sap you will find a pointer to the
    sap1 file. This enables retrieval and updating of the sap1 file.
    The sap file contains a 128-word header where some housekeeping
    information is stored.  See below for header info.  The
    following REQUIRE's have standard
    declarations, graphics procedures, procedures to manipulate
    apars and sap1 file, respectively.  If you find an identifier
    not declared in this module, you must check the REQUIRE files. ;

	require  "<babu>define.sai"  source!file;
	require  "<babu>grafix.dcl"  source!file;
	require  "<babu>apar.dcl"  source!file;
	require  "<babu>sap1.dcl"  source!file;
	require  "<babu>sap1.rel"  load!module;


! Explanation of the sap data structure.
  A dynamically allocated record structure keeps a sap record in
  core.
	Name: id of the super-antiparallel.
	pr1, pc1: coordinates of one end.
	pr2, pc2: coordinates of the other end.
  	color: real number indicating width as well as relative
		brightness, e.g. -3.5 indicates an super-antiparallel
		with width 3.5 pixels and which is dark relative
		to its surroundings.
	length: length of the sap.
    	noofapar: No of apars making up the sap.
        ptr1: pointer to .sap1 file where ids of component apars
              are stored.
        ss: supersegment responsible for the sap. For saps that
            have been merged, this should be zero.;

  record!class  sap(
              integer  name,pr1,pc1,pr2,pc2;
              real  color, length;
              integer  noofapar, ptr1, ss);
  define  sapsz = "10";

  record!pointer (sap) psap;

  external  string  picture;

  safe  integer  array  header [0:hdrl-1];
  !  Header  information  in  .sap files.  This info contains 
     quantities like picture size, size of the record in the file,
     no of saps, etc. The brief commentary describing the identifiers
     should be generally sufficient to indicate their use. ;

    define  recsz = "header[1]";	! record size in the file;
    define  rowsz = "header[3]";	! no of rows in the picture;
    define  colsz = "header[4]";	! no of columns;
    define  sapno = "header[5]";	! No of saps in the file;
    define  maxapars = "header[6]";	! Max no of apars in any sap;
    define  lstatus = "header[7]";	! Information in the length
		field of a sap record -- whether it is the real
		length along the supersegment or just an apparent
		one (sum of apar lengths).;
    define  aporder = "header[8]";	! Whether apars are ordered;
    define  howmade = "header[9]",
            applength = "1",
            realength = "2",
            notrans = "1",
            ordered = "1";
    define  bright = "1";		! if the sap is rel. bright;
    define  dark = "-1";		! sap is rel. dark;
    define  maxid = "header[10]";	! Id of sap having max # of apars;
    
  INTEGER  rfile, wfile, rrecsz, wrecsz;
  real  allowedgap;

  internal  simple  procedure  sapreset;
  ! Resets the file to the begnning;
  swdptr(rfile,hdrl);

  internal  simple  procedure  rsaphdr;
  begin
  ! Reads in the header on the .sap file into the buffer area in this module;
    swdptr(rfile,0);  arryin(rfile,header[0],hdrl);
  end;

  internal  simple  procedure  sapout;
  ! Outputs a supersegment onto a diskfile.;
  arryout(wfile,sap:name[psap],wrecsz);

  internal  simple  procedure  sapin;
  comment
  Reads in a supersegment from a diskfile.;
  begin
    arryin(rfile,sap:name[psap],rrecsz);
    sap1sp(sap:ptr1[psap]);
  end;

  internal  simple  procedure  saprdopen;
  begin
  comment  Opens (s)sap file(s) for reading.;
  integer  c;
    rfile := openfile(picture & ".sap","roc");
    arryin(rfile,header[0],hdrl);
    psap := new!record(sap);
    rrecsz := recsz;

    sap1rdopen;

  end;

  internal  simple  procedure  sapwtopen;
  begin
  comment
  Opens diskfiles for writing(only, I guess);
    wrecsz := sapsz;
    psap := new!record(sap);
    wfile := openfile(picture & ".sap","wc");
    swdptr(wfile,hdrl);

    sap1open;

  end;


  internal  simple  procedure  saprclose;
  begin
    cfile(rfile);  sap1rclose;
  end;


  internal  simple  procedure  sapwheader;
  begin
  comment  Write headers onto (s)seg file(s).;
    header[0] := hdrl;  	header[1] := wrecsz;
    header[2] := wrecsz * sapno;
    swdptr(wfile,0);  arryout(wfile,header[0],hdrl);
  end;

  internal  simple  procedure  sapwclose;
  begin
  ! Closes the .sap file if opened for writing;
    sapwheader;
    cfile(wfile);  sap1wclose;
  end;

  internal  simple  procedure  saptty(integer sapid);
  begin  "saptty"
  comment
  This procedure types out contents of .sap files, record by
  record. You give an integer as the id of the .sap 
  and its attributes are typed out.;

  integer  c, na;  REAL  rc;
        swdptr(rfile,hdrl+(sapid-1)*rrecsz);  sapin;
        na := sap:noofapar[psap];
        print(" name: ",sap:name[psap]);
        print(" family(ss): ",sap:ss[psap],crlf);
        print(" noofapar: ",na,"  length: ",sap:length[psap],crlf);
        print(" ",sap:pr1[psap],",",sap:pc1[psap]," to ");
        print(" ",sap:pr2[psap],",",sap:pc2[psap],"  ");
        rc := sap:color[psap];
        if  rc > 0  then  print("bright")  else
        if  rc < 0  then  print("dark");  print(crlf);
    for  c := 1 step 1 until na  do  print(sap1in," ");
    sap1sp(sap:ptr1[psap]);
    print(crlf);
  end;  "sgtty"

  internal  simple  procedure  trace;
  begin  "trace"
  !  This procedure traces a sap on the screen. See also
	procedure  trace1;
  integer  c, na, r1, c1, r2, c2, a, re, ce, t;
    sap1sp(sap:ptr1[psap]);  NA := SAP:NOOFAPAR[psap];
    SEtss(sap:ss[psap]);
    t := sap1in;  c := 1;  movebeg(t);
    if  not  mores1  then  drawend(t);
    while  c < na  do
    begin
      t := sap1in;  drawbeg(t);  c := c + 1;
      while  mores1  and  c < na  do
      begin
        t := sap1in;  drawbeg(t);  c := c + 1;
      end;
      drawend(t);
    end;
  end  "trace" ;

  internal  simple  procedure  trace1;
  begin  "trace1"
  !  This procedure traces a sap on the screen. This checks
     for gaps between apars.  See also 
	procedure  trace;
  integer  c, na, r1, c1, r2, c2, t;  real  gap;
    sap1sp(sap:ptr1[psap]);  NA := SAP:NOOFAPAR[psap];  
    SEtss(sap:ss[psap]);
    c := 0;  r1 := - rowsz;  c1 := - colsz;
    while  c < na  do
    begin
      t := sap1in;  c := c + 1;
      getbeg(t,r2,c2);  gap := sqrt( (r2-r1)↑2 + (C2-c1)↑2 );
      if  gap > allowedgap  then  movecursor(r2,c2)
                            else  drawline(r2,c2);
      while  mores1  and  c < na  do
      begin
        t := sap1in;  drawbeg(t);  c := c + 1;
      end;
      drawend(t);  getend(t,r1,c1);
    end;
  end  "trace1" ;

  internal  simple  procedure  sapdisplay;
  begin
  integer  c, na;
  ! Display of a single sap;
    if  aporder = ordered  then
    begin
      trace1;  return;
    end;
    sap1sp(sap:ptr1[psap]);  na := sap:noofapar[psap];
    for  c := 1 step 1 until na  do
    begin
      aparin(sap1in);  apdisplay;
    end;
  end;

  INTERnal  simple  procedure  saprw2open;
  begin
  ! Opens a sap file for editing (reading and writing).;
    rfile := openfile(picture & ".sap","rwo");
    arryin(rfile,header[0],hdrl);
    wfile := rfile;  rrecsz := recsz;  wrecsz := rrecsz;
    psap := new!record(sap);
    sap1rwopen;
  end;

  internal  simple  procedure  sapinid(integer  sapid);
  begin
  ! Direct access to a particular sap;
    swdptr(rfile,hdrl+(sapid-1)*rrecsz);  sapin;
  end;

  internal  simple  procedure  sapedheader;
  begin
  ! Edit the header on a .sap file;
    iprmpt(" record size",recsz);
    iprmpt(" row size of picture",rowsz);
    iprmpt(" col size of picture",colsz);
    iprmpt(" Total no of sap",sapno);
    iprmpt(" Max no of apars in a sap",maxapars);
    iprmpt(" length info -- 0: none, 1: apparent length, 2: real
      length",lstatus);
    iprmpt(" Order info -- 0: no order, 1: ordered",aporder);
    wrecsz := recsz;
    sapwheader;
  end;

  internal  simple  procedure  sapdata(integer n, r, c);
  begin
  ! Stores no of saps, etc. into the .sap header;
    sapno := n;  rowsz := r;  colsz := c;
  end;

  internal  simple  integer  procedure  noofsaps;
  begin
  ! Returns the number of saps;
    return(sapno);
  end;

  internal  simple  integer  procedure  napinsap;
  ! Returns the number of apars in the currently addressed sap;
  return(sap:noofapar[psap]);

  internal  simple  procedure  addlinfo;
  begin
  integer  c, na;  real  l;
  ! Adds apparent length info to the length record of a sap.
    Apparent length is defined as the sum of the component apar 
    lengths;
    sapin;
    sap1sp(sap:ptr1[psap]);  na := sap:noofapar[psap];
    l := 0.0;
    FOR  c := 1 step 1 until na  do
    begin
    integer  temp;
      temp := sap1in;  aparin(temp);
      l := l + aparlen;
    end;
    sap:length[psap] := l;
    swdptr(wfile,rwdptr(wfile)-sapsz);  sapout;
  end;

  internal  simple  procedure  applsap;
  ! Makes note of the fact that the file contains apparent lengths;
  lstatus := applength;

  internal  simple  real  procedure  saplength;
  begin
  ! Returns the length of the currently addressed sap;
  return(sap:length[psap]);
  end;

  internal  simple integer  procedure  getstatus;
  ! Returns the length status in the file -- whether apparent
    or real;
  return(lstatus);

  internal  simple  procedure  getaps(reference safe integer array a);
  begin
  integer  c, na;
  ! Returns the id's component apars for the currently addressed
    sap;
    sap1sp(sap:ptr1[psap]);  na := sap:noofapar[psap];
    for  c := 1 step 1 until na  do  a[c] := sap1in;
    sap1sp(sap:ptr1[psap]);
  end;

  internal  simple  procedure  putostatus;
  ! Notes the status of apar info -- whether ordered.;
  aporder := ordered;

  internal  simple  boolean  procedure  isordered;
  ! Tells you if the apars in the file are ordered.;
  return(if  aporder = ordered  then  true  else  false);

  internal  simple  procedure  setnotrans;
  ! Note the fact that the sap was made without making use of
    transitivity among them;
  howmade := notrans;

  internal  simple  integer  procedure  mnapinsap;
  ! Returns the maximum number of apars in a sap as stored in the
    header. Crucial to several programs. Please make sure that this
    information is filled in as soon as the .sap file is made;
  return(maxapars);

  internal  procedure  dep2sap(integer  nm, b, e;  safe  integer  array  a;  integer  ssid);
  begin
  integer  c;
  ! Deposits information about a sap -- while making the .sap 
    files;
    sap:name[psap] := nm;  sap:noofapar[psap] := e-b+1;
    sap:ptr1[psap] := PTR1POS;
    for  c := b step 1 until e  do  sap1out(a[C]);
    sap:ss[psap] := ssid;
    sapout;
  end;

  internal  simple  procedure  smnp;
  begin
  !  PROCEDURE  to set the value of  maximum number of apars in
    a sap into the module  <babu>order.;
    external  simple  procedure  setmnp;
    setmnp;
  end;

  internal  simple  integer  procedure  sapfamily;
  ! Returns the id of the supersegment responsible for the 
    currently addressed sap;
  return(sap:ss[psap]);

  internal  simple  procedure  saptofile(integer  chan);
  begin
  integer  c, na;
  ! Procedure to write out sap information onto an output file.
    This is useful for large-scale debugging;
    sapin;
    na := sap:noofapar[psap];
    cprint(chan," name: ",sap:name[psap]);
    cprint(chan," family(ss): ",sap:ss[psap]);
    cprint(chan," noofapar: ",na,"  length: ",sap:length[psap],crlf);
    cprint(chan,"  ",sap:pr1[psap]);
    cprint(chan,"  ",sap:Pc1[psap]," to ");
    cprint(chan,"  ",sap:pr2[psap]);
    cprint(chan,"  ",sap:pc2[psap], crlf);
    cprint(chan," apars: ");
    for  c := 1 step 1 until na  do  cprint(chan,sap1in," ");
    cprint(chan,crlf,crlf,crlf);
  end;

  internal  simple  procedure  sapfilter(integer ochan);
  begin
  integer  which, c, n, k;  boolean  yes;  
  ! Procedure to extract a small no of saps from a sap file.
    This is particularly useful for debugging.
    ochan is the channel on which the new file will be 
    created. It will be empty when this procedure is called.;

    swdptr(ochan,hdrl);
    c := 0;
     do  begin
      iprmpt(" starting sap.",which);  iprmpt(" how many",n);
      for  k := 0 step 1 until n-1  do
      begin
        sapinid(which+k);
        arryout(ochan,sap:name[psap],rrecsz);
      end;
      bprmpt(" Any more",yes);  c := c + n;
    end  until  not yes;
    sapno := c;
    swdptr(ochan,0);  arryout(ochan,header[0],hdrl);
    cfile(ochan);
  end;

  internal  simple  procedure  getcolor;
  begin
  ! procedure to put color information into a sap record;
    sapin;  aparin(sap1in);
    if  apbright  then  sap:color[psap] := bright*1.0
                  else  sap:color[psap] := dark*1.0;
    swdptr(wfile,rwdptr(wfile)-sapsz);  sapout;
  end;

  internal  simple  integer  procedure  sapcolor;
  begin
  real  rc;  integer  c;
  ! Returns the relative color of the sap in the core;
    rc := sap:color[psap];
    if  rc > 0  then  c := 1  else
    if  rc < 0  then  c := -1  else  c := 0;
    return(c);
  end;

  internal  simple  procedure  setgap;
  rprmpt(" Max allowed gap between apars of different segments",allowedgap);

  internal  simple  procedure  putmnp(integer i, n);
  begin
  ! puts the id of sap which has max # of component apars in the
    header, as also the max #;
    maxid := i;  maxapars := n;
  end;

internal  simple  procedure  putmax(integer max);
! Stores the max # of apars in any sap;
maxapars := max;

  internal  simple  procedure  sapicsize(reference integer r, c);
  begin
    r := rowsz;  c := colsz;
  end;

end  "sap" ;